home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / PenShare / PenShare.p
Encoding:
Text File  |  1997-05-06  |  3.4 KB  |  110 lines
  1. Program PenShare;
  2.  
  3. { Dieses Programm demonstriert die ObtainPen Funktion der graphics.lib V39+
  4.  
  5.   Ab OS3.0 gibt es sogenanntes Pen Sharing. Das bedeutet, daß sich
  6.   verschiedene Programme die Farben der Workbench teilen. Zum Beispiel
  7.   können Sie mit Multiview 2 Bilder mit 256 auf der Workbench anzeigen,
  8.   wobei beide noch relativ gut aussehen.
  9.  
  10.   Mit der Funktion ObtainPen können Sie sich ein Farbregister mit einem
  11.   ganz bestimmten Farbwert reservieren lassen.
  12.  
  13.   Es gibt noch eine zweite Funktion namens ObtainBestPen (Multiview
  14.   benutzt diese Fkt.). Mit ihr werden die Farbwerte nicht 100%ig exakt
  15.   behandelt. So wird z.B. zwei leicht unterschiedlichen Rottönen dasselbe
  16.   Farbregister zugeordnet.
  17.  
  18.  
  19.   Autor: Andreas Tetzl
  20.   Datum: 22.12.1994
  21. }
  22.  
  23. {$I "Include:Intuition/Intuition.i"}
  24. {$I "Include:Graphics/Graphics.i"}
  25. {$I "Include:Graphics/Pens.i"}
  26. {$I "Include:Graphics/Text.i"}
  27. {$I "Include:Graphics/View.i"}
  28. {$I "Include:Utility/Utility.i"}
  29. {$I "Include:Utils/TagUtils.i"}
  30. {$I "Include:Exec/Ports.i"}
  31.  
  32. VAR RP : RastPortPtr;
  33.     Win : WindowPtr;
  34.     Colors : Array[0..2] of Integer;
  35.     Msg : MessagePtr;
  36.     VP : ViewPortPtr;
  37.     i : Integer;
  38.     TagList : Address;
  39.  
  40. PROCEDURE CleanExit(Why : String; RC : Integer);
  41. Begin
  42.  For i:=0 to 2 do
  43.   If Colors[i]<>-1 then ReleasePen(VP^.ColorMap,Colors[i]);
  44.  
  45.  If Win<>NIL then CloseWindow(Win);
  46.  If GfxBase<>NIL then CloseLibrary(GfxBase);
  47.  If UtilityBase<>NIL then CloseLibrary(UtilityBase);
  48.  If Why<>NIL then Writeln(Why);
  49.  Exit(RC);
  50. end;
  51.  
  52. Begin
  53.  For i:=0 to 2 do Colors[i]:=-1; { Farbwerte vorbelegen (wegen CleanExit()) }
  54.  
  55.  UtilityBase:=OpenLibrary("utility.library",39);
  56.  If UtilityBase=NIL then CleanExit("Benötige mindestens OS 3.0 !",10);
  57.  
  58.  GfxBase:=OpenLibrary("graphics.library",39);
  59.  If GfxBase=NIL then CleanExit("Kann graphics.library nicht öffnen",10);
  60.  
  61.  TagList:=CreateTagList(WA_Width,150,
  62.                         WA_Height,100,
  63.                         WA_Title,"PenShare",
  64.                         WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR,
  65.                         WA_IDCMP,IDCMP_CLOSEWINDOW,
  66.                         TAG_END);
  67.  
  68.  Win:=OpenWindowTagList(nil,TagList);
  69.  FreeTagItems(TagList);
  70.  If Win=NIL then CleanExit("Kann Fenster nicht öffnen",10);
  71.  VP:=ViewPortAddress(Win);
  72.  RP:=Win^.RPort;
  73.  
  74.  { Für n geben Sie die gewünschte Farbregisternummer }
  75.  { an (-1, wenn es Ihnen egal ist).                  }
  76.  { Die folgenden drei RGB-Werte müssen die ganzen    }
  77.  { 32 Bit ausnutzen. Wenn Sie z.B. für Rot den Wert  }
  78.  { $F0 setzen wollen, müssen Sie in r den Wert       }
  79.  { $F0F0F0F0 einsetzen !                             }
  80.  { Wenn Sie die Farbe später verändern               }
  81.  { (z.B. ColorCycling), müssen Sie im Flags          }
  82.  { Parameter PENF_EXCLUSIVE setzen !                 }
  83.  { (siehe Include:graphics/View.i                    }
  84.  
  85.  Colors[0]:=ObtainPen(VP^.ColorMap,-1,$FFFFFFFF,0,0,0); { Rot  }
  86.  Colors[1]:=ObtainPen(VP^.ColorMap,-1,0,$FFFFFFFF,0,0); { Grün }
  87.  Colors[2]:=ObtainPen(VP^.ColorMap,-1,0,0,$FFFFFFFF,0); { Blau }
  88.  If (Colors[0]=-1) or (Colors[1]=-1) or (Colors[1]=-1) then 
  89.   CleanExit("Bitte stellen Sie mehr Farben für die Workbench ein.",10);
  90.  
  91.  SetAPen(RP,Colors[0]);
  92.  Move(RP,40,40);
  93.  GText(RP,"Rot",3);
  94.  
  95.  SetAPen(RP,Colors[1]);
  96.  Move(RP,40,60);
  97.  GText(RP,"Grün",4);
  98.  
  99.  SetAPen(RP,Colors[2]);
  100.  Move(RP,40,80);
  101.  GText(RP,"Blau",4);
  102.  
  103.  Msg:=WaitPort(Win^.UserPort);
  104.  Msg:=GetMsg(Win^.UserPort);
  105.  ReplyMsg(Msg);
  106.  
  107.  CleanExit(NIL,0);
  108. end.
  109.  
  110.